home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug / vector-space.scm < prev    next >
Text File  |  1995-10-13  |  4KB  |  133 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4.  
  5. ; ,open architecture primitives low-level locations debug-data syntactic
  6.  
  7. ; July 5th
  8. ;total number of 3-vectors: 10896
  9. ;probably table entries: 10381
  10. ;symbol keys: 7363
  11. ;integer keys: 3018
  12. ;symbol values: 3793
  13. ;location values: 2062
  14. ;pair values: 1723
  15. ;operator values: 989
  16. ;debug-data values: 1208
  17. ;transform values: 510
  18. ;            pair   4039   48468
  19. ;          symbol   1067    8536
  20. ;          vector   4477  124132
  21. ;         closure   1541   18492
  22. ;        location    807    9684
  23. ;            port      2      40
  24. ;           ratio      0       0
  25. ;          record    579   16732
  26. ;    continuation      6     136
  27. ; extended-number      0       0
  28. ;        template    985   23916
  29. ;    weak-pointer     33     264
  30. ;        external      0       0
  31. ;unused-d-header1      0       0
  32. ;unused-d-header2      0       0
  33. ;          string   1207   19338
  34. ;     code-vector    986   51097
  35. ;          double      0       0
  36. ;          bignum      0       0
  37. ;           total  15729  320835
  38.  
  39.  
  40. (define (analyze-3-vectors)
  41.   (collect)
  42.   (let ((vs (find-all-xs (enum stob vector)))
  43.     (total 0)
  44.     (table-entries 0)
  45.     (symbol-keys 0)
  46.     (int-keys 0)
  47.     (symbols 0)
  48.     (locations 0)
  49.     (debug-datas 0)
  50.     (pairs 0)
  51.     (operators 0))
  52.     (set! *foo* '())
  53.     (vector-for-each
  54.      (lambda (v)
  55.        (if (= (vector-length v) 3)
  56.        (let ((x (vector-ref v 2)))
  57.          (set! total (+ total 1))
  58.          (cond ((or (vector? x) (eq? x #f))
  59.             (set! table-entries (+ table-entries 1))
  60.             (let ((key (vector-ref v 0)))
  61.               (cond ((symbol? key)
  62.                  (set! symbol-keys (+ symbol-keys 1)))
  63.                 ((integer? key)
  64.                  (set! int-keys (+ int-keys 1)))))
  65.             (let ((val (vector-ref v 1)))
  66.               (cond ((symbol? val)
  67.                  (set! symbols (+ symbols 1)))
  68.                 ((location? val)
  69.                  (set! locations (+ locations 1)))
  70.                 ((pair? val)
  71.                  (set! pairs (+ pairs 1)))
  72.                 ((transform? val)
  73.                  (set! operators (+ operators 1)))
  74.                 ((debug-data? val)
  75.                  (set! debug-datas (+ debug-datas 1)))
  76.                 (else (set! *foo* (cons v *foo*))))))))))
  77.      vs)
  78.     (display "total number of 3-vectors: ") (write total) (newline)
  79.     (display "probably table entries: ") (write table-entries) (newline)
  80.     (display "symbol keys: ") (write symbol-keys) (newline)
  81.     (display "integer keys: ") (write int-keys) (newline)
  82.     (display "symbol values: ") (write symbols) (newline)
  83.     (display "location values: ") (write locations) (newline)
  84.     (display "pair values: ") (write pairs) (newline)
  85.     (display "transform values: ") (write operators) (newline)
  86.     (display "debug-data values: ") (write debug-datas) (newline)))
  87.  
  88. (define *foo* '())
  89.  
  90. (define (bar)
  91.   (collect)
  92.   (vector-size-histogram (find-all-xs (enum stob vector))))
  93.  
  94. (define (vector-size-histogram vs)
  95.   (write (vector-length vs)) (display " vectors") (newline)
  96.   (let ((n 0))
  97.     (vector-for-each (lambda (v)
  98.                (if (eq? v vs) 'foo
  99.                (if (> (vector-length v) n)
  100.                    (set! n (vector-length v)))))
  101.              vs)
  102.     (display "longest: ") (write n) (newline)
  103.     (let ((hist (make-vector (+ n 1) 0)))
  104.       (vector-for-each (lambda (v)
  105.              (let ((l (vector-length v)))
  106.                (vector-set! hist l (+ (vector-ref hist l) 1))))
  107.                vs)
  108.       (let loop ((i 0))
  109.     (if (< i n)
  110.         (let ((m (vector-ref hist i)))
  111.           (if (> m 0)
  112.           (begin (write-padded i 6)
  113.              (write-padded m 7)
  114.              (write-padded (* (+ (* i m) 1) 4) 7)
  115.              (newline)))
  116.           (loop (+ i 1))))))))
  117.  
  118. (define (write-padded x pad)
  119.   (let ((s (if (symbol? x)
  120.            (symbol->string x)
  121.            (number->string x))))
  122.     (do ((i (- pad (string-length s)) (- i 1)))
  123.     ((<= i 0) (display s))
  124.       (write-char #\space))))
  125.  
  126.  
  127. (define (vector-for-each proc v)
  128.   (let ((z (vector-length v)))
  129.     (do ((i (- z 1) (- i 1)))
  130.     ((< i 0) #f)
  131.       (if (not (vector-unassigned? v i))
  132.       (proc (vector-ref v i))))))
  133.